home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Music / MISC / Lichtorgel / Lichtorgel.mod < prev    next >
Text File  |  1995-08-23  |  12KB  |  452 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.     Lichtorgel.mod
  3.   :Contents.    Simulation einer 8-Kanal Lichtorgel
  4.   :Author.      Christian Stiens
  5.   :Address.     Heustiege 2, W-4710 Lüdinghausen
  6.   :Copyright.   Freeware, All Rights Reserved, © 1992 by cs-soft
  7.   :Language.    Oberon-2
  8.   :Translator.  Amiga Oberon V2.42d (inofficial ß-version)
  9.   :History.     V1.0, 07-Sep-92
  10.   :Imports.     Menu (AMOK #59), FFT (AMOK #68)
  11. ---------------------------------------------------------------------------*)
  12.  
  13. (* $StackChk-  weil wenig lokale Variablen und keine Rekursion *)
  14.  
  15. MODULE Lichtorgel;
  16.  
  17.   IMPORT
  18.     au := Audio,
  19.     e  := Exec,
  20.     es := ExecSupport,
  21.           FFT,
  22.     g  := Graphics,
  23.     hw := Hardware,
  24.     I  := Intuition,
  25.           Misc,
  26.     m  := Menu,
  27.     rq := Requests,
  28.     ol := OberonLib,
  29.     sys:= SYSTEM;
  30.  
  31.   CONST
  32.     ver = "\o$VER: lichtorgel 1.0 (7.9.92)\n\r";
  33.     oom = "Speichermangel";
  34.  
  35.   CONST
  36.     n = 16;           (* 16 Punkt FFT *)
  37.  
  38.   VAR
  39.     nw       : I.NewWindow;
  40.     win      : I.WindowPtr;
  41.     scr      : I.ScreenPtr;
  42.     menu     : I.MenuPtr;
  43.     ioa      : au.IOAudioPtr;
  44.     mes      : I.IntuiMessage;
  45.     pp,pb    : e.APTR;
  46.     chan     : SHORTINT;
  47.     col      : ARRAY 16 OF INTEGER;
  48.     i,w,x,y  : INTEGER;
  49.     shift    : INTEGER;
  50.     rp       : g.RastPortPtr;
  51.     vp       : g.ViewPortPtr;
  52.     hold     : ARRAY 8 OF INTEGER;
  53.     xreal,
  54.     ximag    : ARRAY n OF INTEGER;
  55.     sintab ["_sintab_1024x16"] : ARRAY 1024 OF INTEGER;
  56.  
  57. (*---------------------------------------------------------------------*)
  58.  
  59.   TYPE InitProc = PROCEDURE(ioReq: e.MessagePtr);
  60.  
  61.   PROCEDURE OpenDev (name   : ARRAY OF CHAR;
  62.                      unit   : LONGINT;
  63.                      flags  : LONGSET;
  64.                      ioSize : INTEGER;
  65.                      ioInit : InitProc): e.MessagePtr; (* $CopyArrays- *)
  66.     VAR
  67.       port: e.MsgPortPtr;
  68.       ioReq: e.IORequestPtr;
  69.  
  70.   BEGIN
  71.     port := es.CreatePort("",0);
  72.     IF port = NIL THEN RETURN NIL END;
  73.     IF ioSize = 0 THEN ioSize := SIZE(e.IOStdReq) END;
  74.     ioReq := es.CreateExtIO(port,ioSize);
  75.     IF ioReq = NIL THEN es.DeletePort(port); RETURN NIL END;
  76.     IF ioInit # NIL THEN ioInit(ioReq) END;
  77.     IF e.OpenDevice(name,unit,ioReq,flags) # 0 THEN
  78.       es.DeleteExtIO(ioReq);
  79.       es.DeletePort(port);
  80.       RETURN NIL
  81.     END;
  82.     RETURN ioReq;
  83.   END OpenDev;
  84.  
  85.   PROCEDURE CloseDev (ioReq: e.MessagePtr);
  86.     VAR port: e.MsgPortPtr;
  87.   BEGIN
  88.     port := ioReq.replyPort;
  89.     e.CloseDevice(ioReq);
  90.     es.DeleteExtIO(ioReq);
  91.     es.DeletePort(port);
  92.   END CloseDev;
  93.  
  94. (*---------------------------------------------------------------------*)
  95.  
  96.   PROCEDURE MakeTmpRas (rp: g.RastPortPtr);
  97.     VAR tmpRas : g.TmpRasPtr;
  98.         buffer : e.ADDRESS;
  99.         size   : LONGINT;
  100.   BEGIN
  101.     size := LONG(rp.bitMap.bytesPerRow) * LONG(rp.bitMap.rows);
  102.     INCL(ol.MemReqs,e.chip);
  103.     ol.New(buffer,size);
  104.     EXCL(ol.MemReqs,e.chip);
  105.     NEW(tmpRas);
  106. (*  rq.Assert((buffer # NIL) & (tmpRas # NIL),oom);   macht OberonLib v2.42 *)
  107.     g.InitTmpRas(tmpRas^,buffer,size);
  108.     rp.tmpRas := tmpRas;
  109.   END MakeTmpRas;
  110.  
  111.   PROCEDURE MakeArea (rp: g.RastPortPtr; maxvectors: INTEGER);
  112.     VAR areaInfo : g.AreaInfoPtr;
  113.         buffer   : e.ADDRESS;
  114.   BEGIN
  115.     ol.New(buffer,maxvectors * 5);
  116.     NEW(areaInfo);
  117.     g.InitArea(areaInfo^,buffer,maxvectors);
  118.     rp.areaInfo := areaInfo;
  119.   END MakeArea;
  120.  
  121. (*---------------------------------------------------------------------*)
  122.  
  123.   PROCEDURE Record;
  124.     VAR i,j: INTEGER;
  125.         prb: SHORTINT;
  126.         audci: SHORTINT;
  127.   BEGIN
  128.     (* $RangeChk- $OvflChk- $NilChk- *)
  129.  
  130.     audci := hw.aud0i + chan;
  131.  
  132.     (* Audio-Kanal für's Timing benutzen: *)
  133.  
  134.     hw.custom.intena := {audci};        (* Audio-Interrupt sperren *)
  135.  
  136.     hw.custom.aud[chan].ptr := NIL;
  137.     hw.custom.aud[chan].len := 1;       (* 1 Wort *)
  138.     hw.custom.aud[chan].per := 83;      (* Sampl.Freq = ca. 21 kHz *)
  139.     hw.custom.aud[chan].vol := 0;
  140.  
  141.     hw.custom.dmacon := {hw.aud0+chan}; (* DMA aus *)
  142.  
  143.     e.Disable;                          (* No interrupts, please *)
  144.  
  145.     hw.custom.intreq := {audci};
  146.     hw.custom.aud[chan].dat := 0;
  147.     prb := sys.VAL(SHORTINT,hw.ciaa.prb) + sys.VAL(SHORTINT,-128);
  148.      (* grrr, blöder Compiler, man muß ihn zwingen, zu glauben,
  149.         daß -128 noch SHORTINT ist :-( *)
  150.  
  151.     FOR i := 0 TO n-1 DO
  152.  
  153.       REPEAT UNTIL audci IN hw.custom.intreqr; (* Auf Audio-Interrupt warten *)
  154.       hw.custom.intreq := {audci};             (* Interrupt-Bit zurücksetzen *)
  155.       hw.custom.aud[chan].dat := 0;
  156.  
  157.       (* Parallel-Port lesen: *)
  158.  
  159.       prb := sys.VAL(SHORTINT,hw.ciaa.prb) + sys.VAL(SHORTINT,-128);
  160.  
  161.       xreal[i] := LONG(prb);
  162.  
  163.     END;
  164.  
  165.     e.Enable;
  166.  
  167.     (* Mit Hammingfunktion gewichten: *)
  168.  
  169.     FOR i := 0 TO n-1 DO
  170.       j := (i * (1024 DIV n) + 768) MOD 1024;
  171.       xreal[i] := xreal[i] * (sintab[j] DIV 512 + 64);
  172.       ximag[i] := 0;
  173.     END;
  174.  
  175.     (* $RangeChk= $OvflChk= $NilChk= *)
  176.  
  177.   END Record;
  178.  
  179. (*---------------------------------------------------------------------*)
  180.  
  181.   PROCEDURE Analyse;
  182.   BEGIN
  183.     FFT.FFT(xreal,ximag,n);  (* Fast-Fourier-Transform aufrufen *)
  184.     FFT.Abs(xreal,ximag,9);  (* Absolutwerte der komplexen Zahlen berechnen *)
  185.   END Analyse;
  186.  
  187. (*---------------------------------------------------------------------*)
  188.  
  189.   PROCEDURE Muls(x{0},y{1}: INTEGER): LONGINT; (* $EntryExitCode- *)
  190.   BEGIN
  191.     sys.INLINE(0C1C1H,04E75H);
  192.   END Muls;
  193.  
  194. (*---------------------------------------------------------------------*)
  195.  
  196.   PROCEDURE SetCols;
  197.  
  198.     TYPE
  199.       Eq = ARRAY 8 OF INTEGER;
  200.  
  201.     CONST
  202.       eq = Eq(64,256,297,341,384,427,469,512);  (* Equalizer: Alle Lampen
  203.                                                    sollen im Durchschnitt
  204.                                                    gleich hell sein *)
  205.     VAR
  206.       i,c: INTEGER;
  207.       s: SET;
  208.  
  209.   BEGIN
  210.     FOR i := 0 TO 7 DO
  211.       w := 0;
  212.       s := sys.VAL(SET,i);
  213.       IF s = {} THEN s := {0,2} END;
  214.       c := SHORT(ASH(Muls(xreal[i+1],eq[i]),shift));
  215.       IF c > 15 THEN c := 15 END;
  216.       IF c > hold[i] THEN hold[i] := c
  217.                      ELSE c := hold[i] END;
  218.       IF 0 IN s THEN INC(w,c) END; c := ASH(c,4);
  219.       IF 1 IN s THEN INC(w,c) END; c := ASH(c,4);
  220.       IF 2 IN s THEN INC(w,c) END;
  221.       col[i+4] := w;
  222.       DEC(hold[i]);
  223.     END;
  224.     g.LoadRGB4(vp,col,12);
  225.   END SetCols;
  226.  
  227. (*---------------------------------------------------------------------*)
  228.  
  229.   PROCEDURE MakeMenu(win: I.WindowPtr);
  230.   BEGIN
  231.     m.StartMenu(win);
  232.  
  233.     m.NewMenu("Projekt");
  234.     m.NewItem("Über...","U");
  235.     m.NewItem("Ende","E");
  236.  
  237.     m.NewMenu("Kanal");
  238.     m.NewItem("Links","L");
  239.     m.NewItem("Rechts","R");
  240.  
  241.     m.NewMenu("Pegel");
  242.     m.NewItem("Niedrig","1");
  243.     m.NewItem("Mittel","2");
  244.     m.NewItem("Hoch","3");
  245.  
  246.     menu := m.EndMenu();
  247.     IF I.SetMenuStrip(win,menu^) THEN END;
  248.   END MakeMenu;
  249.  
  250. (*---------------------------------------------------------------------*)
  251.  
  252.   PROCEDURE GetIMsg(win: I.WindowPtr; VAR mes: I.IntuiMessage);
  253.     VAR msg: I.IntuiMessagePtr;
  254.   BEGIN
  255.     msg := e.GetMsg(win.userPort);
  256.     IF msg # NIL THEN
  257.       mes := msg^;
  258.       e.ReplyMsg(msg)
  259.     ELSE
  260.       mes.class := LONGSET{}
  261.     END
  262.   END GetIMsg;
  263.  
  264. (*---------------------------------------------------------------------*)
  265.  
  266.   PROCEDURE Flag(s: LONGSET): INTEGER;
  267.     VAR i: INTEGER;
  268.   BEGIN
  269.     IF s = LONGSET{} THEN RETURN 0
  270.     ELSE i := -1; REPEAT INC(i) UNTIL i IN s; RETURN i END;
  271.   END Flag;
  272.  
  273. (*---------------------------------------------------------------------*)
  274.  
  275.   PROCEDURE HandleMessage(VAR mes: I.IntuiMessage);
  276.  
  277.     VAR
  278.       item: I.MenuItemPtr; itemNum:INTEGER; menuCode: INTEGER;
  279.  
  280.   BEGIN
  281.  
  282.     CASE Flag(mes.class) OF
  283.  
  284.     | 0:
  285.       RETURN;
  286.  
  287.     | I.closeWindow:
  288.       HALT(0);
  289.  
  290.     | I.menuPick:
  291.  
  292.       menuCode := mes.code;
  293.       WHILE menuCode # I.menuNull DO
  294.         item := I.ItemAddress(menu^,menuCode);
  295.         itemNum := I.ItemNum(menuCode);
  296.         CASE I.MenuNum(menuCode) OF
  297.  
  298.         | 0: (* Projekt *)
  299.  
  300.           CASE itemNum OF
  301.  
  302.           | 0: IF rq.RequestWin("Lichtorgel V1.0",
  303.                                 "© 92 by Christian Stiens",
  304.                                 ""," Ok ",win) THEN END;
  305.           | 1: HALT(0);
  306.           ELSE END;
  307.  
  308.         | 1: (* Kanal *)
  309.  
  310.           IF itemNum = 0 THEN
  311.             INCL(hw.ciab.pra,1);                   (* Linken Kanal *)
  312.             EXCL(hw.ciab.pra,2);                   (* selektieren  *)
  313.           ELSE
  314.             EXCL(hw.ciab.pra,1);                   (* Rechten Kanal *)
  315.             INCL(hw.ciab.pra,2);                   (* selektieren   *)
  316.           END;
  317.  
  318.         | 2: (* Pegel *)
  319.           CASE itemNum OF
  320.           | 0: shift := -14
  321.           | 1: shift := -13
  322.           | 2: shift := -12
  323.           ELSE END;
  324.  
  325.         ELSE
  326.         END;
  327.         menuCode := item.nextSelect;
  328.       END;
  329.     ELSE
  330.     END
  331.   END HandleMessage;
  332.  
  333. (*---------------------------------------------------------------------*)
  334.  
  335.   PROCEDURE IoInit (ioa: e.MessagePtr);
  336.     CONST allocMap = "\x01\x02\x04\x08";
  337.   BEGIN
  338.     WITH ioa: au.IOAudioPtr DO
  339.       ioa.data := sys.ADR(allocMap);
  340.       ioa.length := 4;
  341.       ioa.request.message.node.pri := 127;
  342.     END;
  343.   END IoInit;
  344.  
  345. (*---------------------------------------------------------------------*)
  346.  
  347. BEGIN
  348.   IF ver[0]=0X THEN END;
  349.  
  350.   scr := NIL;
  351.   win := NIL;
  352.   menu := NIL;
  353.   ioa := NIL;
  354.   pp := -1;
  355.   pb := -1;
  356.  
  357.   Misc.base := e.OpenResource(Misc.miscName);
  358.   IF Misc.base=NIL THEN HALT(0) END;
  359.  
  360.   pp := Misc.AllocMiscResource(Misc.parallelPort,"Lichtorgel");
  361.   pb := Misc.AllocMiscResource(Misc.parallelBits,"Lichtorgel");
  362.  
  363.   rq.Assert((pp=NIL) & (pb=NIL),"Parallel Port belegt");
  364.  
  365.   scr := I.OpenScreen(I.NewScreen(0,0,320,200,
  366.                                   4,
  367.                                   0,1,
  368.                                   {},
  369.                                   I.customScreen,
  370.                                   NIL, NIL, NIL, NIL));
  371.  
  372.   rq.Assert(scr # NIL,"Kein Schirm");
  373.  
  374.   nw := I.NewWindow(0,0, 320, 200,
  375.                     0,1,
  376.                     LONGSET{I.menuPick},
  377.                     LONGSET{I.activate,I.backDrop,I.borderless},
  378.                     NIL,NIL,
  379.                     NIL,
  380.                     NIL,NIL, 0,0,0,0,
  381.                     I.customScreen);
  382.   nw.screen := scr;
  383.  
  384.   win := I.OpenWindow(nw);
  385.   rq.Assert(win # NIL,"Kein Fenster");
  386.  
  387.   rp := win.rPort;
  388.   vp := I.ViewPortAddress(win);
  389.  
  390.   col[0] := 0;
  391.   col[1] := 0CCCH;
  392.   col[2] := 000CH;
  393.   col[3] := 0C00H;
  394.   col[14]:= 0C00H;
  395.   col[15]:= 00C0H;
  396.  
  397.   g.LoadRGB4(vp,col,16);
  398.  
  399.   I.ShowTitle(scr,I.LFALSE);
  400.  
  401.   MakeMenu(win);
  402.  
  403.   MakeTmpRas(rp);
  404.   MakeArea(rp,4);
  405.  
  406.   FOR i := 0 TO 7 DO
  407.     x := i DIV 2 * 77 + 44;
  408.     y := i MOD 2 * 88 + 62;
  409.     g.SetAPen(rp,i+4);
  410.     IF g.AreaCircle(rp,x,y,35) THEN END;
  411.     IF g.AreaEnd(rp) THEN END;
  412.   END;
  413.  
  414.   ioa := OpenDev(au.audioName,0,LONGSET{},SIZE(au.IOAudio),IoInit);
  415.   rq.Assert(ioa # NIL,"Can't open audio.device");
  416.  
  417.   CASE sys.VAL(LONGINT,ioa.request.unit) OF
  418.     1: chan := 0 |
  419.     2: chan := 1 |
  420.     4: chan := 2 |
  421.     8: chan := 3     ELSE HALT(0)
  422.   END;
  423.  
  424.   hw.ciaa.ddrb := SHORTSET{};                   (* Alle Bits Eingang *)
  425.   hw.ciab.ddra := hw.ciab.ddra + SHORTSET{1,2}; (* Bit 1 & 2 Output *)
  426.   INCL(hw.ciab.pra,1); EXCL(hw.ciab.pra,2);     (* Linker Kanal *)
  427.  
  428.   shift := -13;                                 (* Mittlerer Pegel *)
  429.  
  430.   LOOP
  431.     GetIMsg(win,mes);
  432.     HandleMessage(mes);
  433.     Record;
  434.     Analyse;
  435.     SetCols;
  436.     IF e.m68020 IN e.exec.attnFlags THEN
  437.                                     g.WaitTOF END; (* 50 mal/sec reicht :-) *)
  438.   END;
  439.  
  440. CLOSE
  441.  
  442.   IF (pp=NIL)&(pb=NIL) THEN hw.ciab.ddra := hw.ciab.ddra-SHORTSET{1,2} END;
  443.   IF ioa # NIL THEN CloseDev(ioa) END;
  444.   IF menu# NIL THEN I.ClearMenuStrip(win) END;
  445.   IF win # NIL THEN I.CloseWindow(win) END;
  446.   IF scr # NIL THEN I.OldCloseScreen(scr) END;
  447.   IF pp=NIL THEN Misc.FreeMiscResource(Misc.parallelPort) END;
  448.   IF pb=NIL THEN Misc.FreeMiscResource(Misc.parallelBits) END;
  449.  
  450. END Lichtorgel.
  451.  
  452.